Przestępczość w 21 Amerykańskich Miastach (2016-2020) EDA

Wprowadzenie

Zbiór danych zawiera ponad 10 milionów wpisów z pakietu crimedata. Każdy wpis reprezentuje przestępstwo i jego okoliczności.

Ja w mojej pracy zajmuję się przestępstwami przeciwko innym ludziom. Rozważam dane z 21 amerykańskich miast w latach 2016-2020.

W swojej pracy przyglądam się kwestii przestępczości.Badam kwestię bezpieczeczeństwa obywateli i turystów. Po lekturze mojej pracy czytelnik dowie się, kiedy jest szczególnie niebezpiecznie w USA, w którym mieście przestępczość jest największa, w jakich porach doby powinniśmy szczególnie na siebie uważać, jaka jest zależność między rodzajem popełnianego przestępstwa, a typem lokalizacji oraz jakie przestępstwo jest najczęściej popełniane w USA. Ponadto przyjrzymy się dokładniej sytuacji w Nowym Yorku.

Zmienne

• uid (liczbowo) Klucz przestępstwa
• city_name (faktor) Nazwa miasta
• offense_code (factor) Kod wykroczenia
• offense_type (factor) Typ wykroczenia
• offense_group (factor) Grupa wykroczenia
• offense_against(factor) Grupa przeciwko której popełniono przestępstwo
• date_single (data z godziną) Data wykroczenia
• longitude (liczbowo) Szerokość geograficzna
• latitude (liczbowo) Wysokość geograficzna
• census_block (tekstowo) Blok spisu ludności

Przygotowanie danych

Pakiety, których używam:

library("crimedata")
library("tidyr")
library("gapminder")
library("dplyr")
library("mice")
library("ggplot2")
library("knitr")
library("pheatmap")
library("leaflet")
library("leaflet.extras")

Otwieram plik

W mojej pracy będę używać danych z pakietu crimedata, pobrałam interesujące mnie dane:

crimes <- readRDS("C:\\Users\\48794\\Documents\\AGH\\2rok\\R\\crimes_data.rds")

Oglądam moje dane.

head(crimes, 5)

## # A tibble: 5 × 14
##      uid city_name offense_code offense_type       offense_group offense_against
##    <int> <fct>     <fct>        <fct>              <fct>         <fct>          
## 1 971488 Austin    23H          all other larceny  larceny/thef… property       
## 2 971489 Austin    22U          other burglary/br… burglary/bre… property       
## 3 971490 Austin    23H          all other larceny  larceny/thef… property       
## 4 971491 Austin    23H          all other larceny  larceny/thef… property       
## 5 971492 Austin    250          counterfeiting/fo… counterfeiti… property       
## # ℹ 8 more variables: date_single <dttm>, longitude <dbl>, latitude <dbl>,
## #   location_type <fct>, location_category <fct>, census_block <chr>,
## #   date_start <dttm>, date_end <dttm>

tail(crimes, 5)

## # A tibble: 5 × 14
##        uid city_name     offense_code offense_type offense_group offense_against
##      <int> <fct>         <fct>        <fct>        <fct>         <fct>          
## 1 29703980 Virginia Bea… 90Z          all other o… all other of… other          
## 2 29703981 Virginia Bea… 290          destruction… destruction/… property       
## 3 29703982 Virginia Bea… 520          weapon law … weapon law v… society        
## 4 29703983 Virginia Bea… 22A          residential… burglary/bre… property       
## 5 29703984 Virginia Bea… 290          destruction… destruction/… property       
## # ℹ 8 more variables: date_single <dttm>, longitude <dbl>, latitude <dbl>,
## #   location_type <fct>, location_category <fct>, census_block <chr>,
## #   date_start <dttm>, date_end <dttm>

Z tej ramki danych, interesują mnie przestępstwa popełniane przeciwko ludziom.

persons_crimes <- crimes %>%
  filter (offense_against == "persons")

Przed sprawdzeniem typów danych i braków danych, tworzę trzy nowe kolumny: year, month, hour. Będę ich używać w późniejszej analizie.

persons_crimes$year <- format(persons_crimes$date_single, "%Y")
persons_crimes$month <- format(persons_crimes$date_single, "%m")
persons_crimes$hour <- format(persons_crimes$date_single, "%H")

Sprawdzę teraz typ moich danych.

str(persons_crimes)

## tibble [2,196,270 × 17] (S3: tbl_df/tbl/data.frame)
##  $ uid              : int [1:2196270] 971498 971508 971516 971518 971523 971526 971529 971534 971544 971545 ...
##  $ city_name        : Factor w/ 21 levels "Austin","Boston",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ offense_code     : Factor w/ 79 levels "09A","09B","100",..: 26 26 26 26 26 26 26 26 26 26 ...
##  $ offense_type     : Factor w/ 68 levels "aggravated assault",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ offense_group    : Factor w/ 33 levels "all other offenses",..: 3 3 3 3 3 3 3 3 3 3 ...
##  $ offense_against  : Factor w/ 4 levels "other","persons",..: 2 2 2 2 2 2 2 2 2 2 ...
##  $ date_single      : POSIXct[1:2196270], format: "2016-01-01 00:00:00" "2016-01-01 00:00:00" ...
##  $ longitude        : num [1:2196270] -97.7 -97.7 -97.7 -97.7 -97.7 ...
##  $ latitude         : num [1:2196270] 30.4 30.3 30.2 30.4 30.3 ...
##  $ location_type    : Factor w/ 37 levels "abandoned","airport",..: 30 NA 30 18 30 30 30 30 NA 30 ...
##  $ location_category: Factor w/ 14 levels "commercial","education",..: 9 NA 9 5 9 9 9 9 NA 9 ...
##  $ census_block     : chr [1:2196270] "484530018331004" "484530011001096" "484530024313003" "484530017222012" ...
##  $ date_start       : POSIXct[1:2196270], format: NA NA ...
##  $ date_end         : POSIXct[1:2196270], format: NA NA ...
##  $ year             : chr [1:2196270] "2016" "2016" "2016" "2016" ...
##  $ month            : chr [1:2196270] "01" "01" "01" "01" ...
##  $ hour             : chr [1:2196270] "00" "00" "00" "00" ...

Wygląda to prawie w porządku, muszę zmienić tylko typ danych w kolumnach year, month i hour na typ numeryczny.

persons_crimes$year <- as.numeric(persons_crimes$year)
persons_crimes$month <- as.numeric(persons_crimes$month)
persons_crimes$hour <- as.numeric(persons_crimes$hour)

Teraz wszystko jest w porządku, zajmijmy się brakami w danych.

Braki danych

Sprawdzam, w której kategorii i w jakiej ilości występują braki danych:

md.pattern(persons_crimes)

##        uid city_name offense_code offense_type offense_group offense_against
## 371887   1         1            1            1             1               1
## 57295    1         1            1            1             1               1
## 11       1         1            1            1             1               1
## 966042   1         1            1            1             1               1
## 26929    1         1            1            1             1               1
## 205335   1         1            1            1             1               1
## 1216     1         1            1            1             1               1
## 465      1         1            1            1             1               1
## 565813   1         1            1            1             1               1
## 8        1         1            1            1             1               1
## 2        1         1            1            1             1               1
## 10       1         1            1            1             1               1
## 172      1         1            1            1             1               1
## 41       1         1            1            1             1               1
## 1        1         1            1            1             1               1
## 2        1         1            1            1             1               1
## 1041     1         1            1            1             1               1
##          0         0            0            0             0               0
##        longitude latitude census_block date_single year month hour
## 371887         1        1            1           1    1     1    1
## 57295          1        1            1           1    1     1    1
## 11             1        1            1           1    1     1    1
## 966042         1        1            1           1    1     1    1
## 26929          1        1            1           1    1     1    1
## 205335         1        1            1           1    1     1    1
## 1216           1        1            1           1    1     1    1
## 465            1        1            1           1    1     1    1
## 565813         1        1            1           1    1     1    1
## 8              1        1            1           0    0     0    0
## 2              1        1            1           0    0     0    0
## 10             1        1            1           0    0     0    0
## 172            1        1            1           0    0     0    0
## 41             1        1            1           0    0     0    0
## 1              1        1            1           0    0     0    0
## 2              1        1            1           0    0     0    0
## 1041           1        1            1           0    0     0    0
##                0        0            0        1277 1277  1277 1277
##        location_category location_type date_start date_end        
## 371887                 1             1          1        1       0
## 57295                  1             1          1        0       1
## 11                     1             1          0        1       1
## 966042                 1             1          0        0       2
## 26929                  1             0          0        0       3
## 205335                 0             0          1        1       2
## 1216                   0             0          1        0       3
## 465                    0             0          0        1       3
## 565813                 0             0          0        0       4
## 8                      1             1          1        1       4
## 2                      1             1          1        0       5
## 10                     1             1          0        1       5
## 172                    1             1          0        0       6
## 41                     0             0          1        1       6
## 1                      0             0          1        0       7
## 2                      0             0          0        1       7
## 1041                   0             0          0        0       8
##                   773914        800843    1560485  1618511 4758861

Bardzo dużo braków występuje w kolumnach: date_start, date_end. Usuwam te kolumny.

persons_crimes <- persons_crimes %>%
  select (-date_start, -date_end)

Zajmijmy się zmienną date_single - braków jest stosunkowo mało. Funkcja fill wypełnia brakujące wartości, używając ostatniej dostępnej wartości. Analogicznie postępuję z kolumnami year, month, hour.

persons_crimes <- persons_crimes %>% fill(date_single, year, month, hour)

Mam dużo braków w location_category oraz location_type. Zamieniam je na other.

persons_crimes$location_category[which(is.na(persons_crimes$location_category))] = "other"
persons_crimes$location_type[which(is.na(persons_crimes$location_type))] = "other"

Ponadto usuwam kolumnę census_block, gdyż nie będę używać jej w swojej pracy.

persons_crimes <- persons_crimes %>%
  select (-census_block)

Ze względu na specyfikę i typ moich danych, nie mam w zestawie danych wartości odstających.

Możemy przejść do pracy.

Praca na danych

Skala zjawiska

W mojej pracy zajmuję się przestępstwami popełnianymi przeciwko ludziom w USA. Aby mieć lepszy obraz sytuacji, sprawdźmy, jak dużą część wszystkich przestępstw stanowią przestępstwa przeciwko ludziom.

#Podliczam ile jest rekordów w każdej z kategorii `offense_against`
crimes_data <- crimes %>%
  group_by(offense_against) %>%
  summarise(number = n())

ggplot(crimes_data, aes(x = "", y = number, fill = offense_against)) +
  geom_bar(stat = "identity", width = 1) +
  coord_polar("y") +
  theme_void() +
  labs(title = "Liczba przestępstw według rodzaju",
       fill = "Rodzaj przestępstwa",
       x = NULL,
       y = NULL) +
  theme(plot.title = element_text(hjust = 0.5))

Widzimy, że mówimy o mniejszości, co na swój sposób jest pocieszającą wiadomością. Sprawdźmy jak to dokładnie wygląda w liczbach:

sum_number_of_crimes <- sum(crimes_data$number)

crimes_data <- crimes_data %>%
  mutate(percent = number*100/sum_number_of_crimes)

kable(crimes_data)

offense_against	number	percent
other	1039904	10.19998
persons	2196270	21.54228
property	5841259	57.29443
society	1117728	10.96332

Utwierdziliśmy się w naszych wcześniejszych przekonaniach - najwięcej jest przestępstw przeciwko własności, stanowią one ponad połowę wszystkich popełnianych przestępstw. Przestępstwa przeciwko ludziom są drugie pod względem częstości występowania.

Zmienność w czasie

Rozważamy dane od 2016 do 2020, Sprawdźmy, jak zmieniała się liczba przestępstw rocznie na przestrzeni tych lat.

crimes_year <- persons_crimes %>%
  group_by(year) %>%
  summarise(number_in_thousands = n()/1000)

ggplot(crimes_year, aes(x = year, y = number_in_thousands)) +
  geom_point() +
  geom_smooth(method = "lm", se = FALSE, color = "blue") +  # Dopasowuje linię trendu
  labs(title = "Liczba przestępstw w czasie",
       y = "Liczba przestępstw w tysiącach",
       x = "Data") +
  coord_cartesian(ylim = c(0, max(crimes_year$number_in_thousands))) +
  theme_minimal() +
  theme(plot.title = element_text(hjust = 0.5))

Widzimy niestety, że liczba przestępstw ma tendencję rosnącą, a 2019 jest rokiem, w którym przestępstw przeciwko ludziom było najwięcej.

Przyjrzyjmy się jeszcze statystykom opisowym, aby zobaczyć, jak wyglądała miesięczna liczba przestępstw w każdym roku.

persons_crimes$year_and_month <- paste(persons_crimes$year, persons_crimes$month, sep = "-")
#Tworze nowa kolumne

persons_date <- persons_crimes %>%
  group_by(year_and_month) %>%
  summarise(number = n()/1000)

persons_date$date <- as.Date(paste0(persons_date$year_and_month, "-01"), format = "%Y-%m-%d")
#Ta kolumna jest mi potrzebna do narysowania poźniejszego wykresu

persons_date$year <- format(persons_date$date, '%Y')

data_by_year <-persons_date %>%
  group_by(year) %>%
  summarise(
    Mean = mean(number),
    Median = median(number),
    SD = sd(number),
    Min = min(number),
    Max = max(number)
  )

kable(data_by_year)

year	Mean	Median	SD	Min	Max
2016	34.54767	34.8045	2.631264	29.629	37.752
2017	35.18633	35.6925	2.946477	29.918	39.115
2018	35.61467	35.5515	3.351230	29.590	40.421
2019	39.97592	40.2940	3.693789	32.765	45.044
2020	37.69792	37.8885	3.221716	32.413	41.822

Średnia miesięczna liczba przestępstw wydaje się rosnąć z roku na rok, osiągając najwyższą wartość w 2019 roku, a następnie malejąc nieznacznie w 2020 roku. Wzrost odchylenia standardowego odzwierciedla większą zmienność w liczbie przestępstw na przestrzeni lat. Zakres (różnica między Min a Max) również rośnie z roku na rok, co wskazuje na zwiększoną zmienność między miesiącami w kolejnych latach.

Najniebezpieczniejszy miesiąc

Wiemy już, że liczba przestępstw wzrasta, spójrzmy, czy któryś z miesięcy jest szczególnie niebezpiecznym.

ggplot(persons_date, aes(x = date, y = number)) +
geom_line(stat = "identity") +
  labs(title = "Liczba przestępstw w miesiącu",
       y = "Liczba przestępstw",
       x = "Data") +
  theme_minimal()+
  theme(plot.title = element_text(hjust = 0.5))

Widzimy, że są miesiące, które szczególnie sprzyjają przestępczości. Sprawdźmy, które miesiące są najniebezpieczniejsze - kiedy przestępstw jest najwięcej.

persons_month <- persons_crimes %>%
  group_by(month) %>%
  summarise(number = n()/1000)

persons_month$name_of_month <- c("January","February","March","April","May","June", "July", "August", "September", "October", "November", "December")

persons_month$month3 <- substr(persons_month$name_of_month, start = 1, stop = 3) %>% toupper()

ggplot(persons_month, aes(x = reorder(month3, month), y = number, 
                          color = "darkblue", fill = "lightblue")) +
geom_bar(stat = "identity") +
labs(title = "Liczba przestępstw w czasie",
      y = "Liczba przestępstw w tysiącach",
      x = "Miesiac") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5),
      legend.position = "none")+ 
  scale_fill_manual(values = c("lightblue" = "lightblue")) +
  scale_color_manual(values = c("darkblue" = "darkblue"))

Z wykresu wynika, że najwięcej przestępstw jest popełnianych w maju i lipcu, sprawdźmy, który z miesięcy był najniebezpieczniejszy.

persons_month[persons_month$number == max(persons_month$number),]

## # A tibble: 1 × 4
##   month number name_of_month month3
##   <dbl>  <dbl> <chr>         <chr> 
## 1     7   204. July          JUL

Lipiec jest miesiącem z największą liczbą przestępstw.

Z historycznego punktu widzenia:

persons_date[persons_date$number == max(persons_date$number),]

## # A tibble: 1 × 4
##   year_and_month number date       year 
##   <chr>           <dbl> <date>     <chr>
## 1 2019-7           45.0 2019-07-01 2019

Lipiec 2019 roku był do tej pory najbardziej niebezpieczny.

Miasta, których lepiej unikać

Sprawdźmy, w którym mieście przestępstw jest najwięcej.

crimes_in_city <- persons_crimes %>%
  group_by(city_name) %>%
  summarise(number_of_crimes_in_thousands = n()/1000) %>%
  arrange(desc(number_of_crimes_in_thousands))

ggplot(crimes_in_city, aes(y = reorder(city_name, number_of_crimes_in_thousands), x = number_of_crimes_in_thousands, fill = "darkblue")) +
  geom_bar(stat = "identity") +
  labs(title = "Liczba przestępstw w poszczególnych miastach",
       x = "Liczba przestępstw w tysiącach",
       y = "Miasto") +
  theme(plot.title = element_text(hjust = 0.5),
      legend.position = "none")+ 
  scale_fill_manual(values = c("darkblue" = "darkblue"))

Z wykresu jasno widać - to Nowy York jest miastem, w którym przestępstw jest najwięcej. Jednakże pamiętajmy, że Nowy York jest też miastem największym. Lepiej jest więc porównywać bezpieczeństwo w miastach na podstawie uniwersalnego współczynnika przestępczości, który mówi nam, ile osób na 1000 to ofiary przestępstwa.

Sprawdźmy jeszcze statystyki opisowe.

summary(crimes_in_city$number_of_crimes_in_thousands)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   17.94   33.20   54.31  104.58  136.90  397.27

sd(crimes_in_city$number_of_crimes_in_thousands)

## [1] 114.3281

wsp_zmienności <- (sd(crimes_in_city$number_of_crimes_in_thousands)/mean(crimes_in_city$number_of_crimes_in_thousands))
wsp_zmienności

## [1] 1.093167

Na podstawie statystyk opisowych możemy stwierdzić, że większość miast ma niską liczbę przestępstw, jednak istnieje kilka miast, które charakteryzują się znacznie wyższą liczbą przestępstw. Stwierdzamy to ze względu na asymetrię prawostronną. Wartość współczynnika zmienności mówi nam o dużym zróżnicowaniu danych.

Współczynnik przestępczości

Spójrzmy, jak wygląda liczba przestępców na liczbę mieszkańców - biorę średnią liczbę mieszkańców z badanego okresu z każdego badanego miasta.

population <- c(8773, 2742, 3849, 631, 508, 638, 2288, 693, 964, 543, 815, 733, 674, 301, 877, 632, 923, 506, 459, 429, 480)

crimes_in_city$population_in_thousands <- population 

crimes_in_city$crime_rate <- crimes_in_city$number_of_crimes_in_thousands*1000/(5*crimes_in_city$population_in_thousands)

ggplot(crimes_in_city, aes(y = reorder(city_name, crime_rate), x = crime_rate,
                           fill = "darkblue")) +
  geom_bar(stat = "identity") +
  labs(title = "Współczynnik przestępczości w poszczególnych miastach",
       x = "Wartość współczynnika przestępczości",
       y = "Miasto") +
  theme(plot.title = element_text(hjust = 0.5),
        legend.position = "none")+ 
  scale_fill_manual(values = c("darkblue" = "darkblue"))

Największą wartość współczynnika widzimy w mieście Kansas City, gdzie ponad 50 osób na 1000 to ofiary przestępstwa.

Dokładne dane prezentują się następująco:

kable(crimes_in_city)

city_name	number_of_crimes_in_thousands	population_in_thousands	crime_rate
New York	397.272	8773	9.056697
Chicago	355.972	2742	25.964406
Los Angeles	321.867	3849	16.724708
Memphis	139.544	631	44.229477
Kansas City	137.082	508	53.969291
Detroit	136.903	638	42.916301
Houston	124.321	2288	10.867220
Nashville	95.003	693	27.417893
Austin	68.151	964	14.139212
Tucson	58.436	543	21.523389
San Francisco	54.308	815	13.327117
Seattle	50.278	733	13.718417
Boston	41.339	674	12.266766
St Louis	38.841	301	25.807973
Charlotte	34.816	877	7.939795
Louisville	33.196	632	10.505063
Fort Worth	26.929	923	5.835103
Mesa	22.321	506	8.822530
Virginia Beach	21.714	459	9.461438
Minneapolis	20.036	429	9.340792
Colorado Springs	17.941	480	7.475417

Czy za dnia jest bezpieczniej?

Często słyszymy o tym, że musimy szczególnie uważać podczas nocnych spacerów, że noc jest czasem niebezpiecznym. Sprawdźmy, czy rzeczywiście przestępstwa mają przede wszystkim miejsce w nocy. W moich rozważaniach przyjmuję noc jako czas od 22 do 6.

Przedstawię, jaki procent stanowią przestępstwa wykonywane nocą dla każdego rodzaju przestępstw.

persons_crimes$time_of_day <- ifelse(persons_crimes$hour <= 6 | persons_crimes$hour >= 22, "Night", "Day")

crimes_type <- persons_crimes %>%
  group_by(offense_type) %>%
  summarise(
    number_of_crimes = n(),
    percents_of_crimes_during_night = sum(time_of_day == "Night")*100 / n()
  )

ggplot(crimes_type, aes(y = reorder(offense_type, percents_of_crimes_during_night), x = percents_of_crimes_during_night)) +
  geom_point(size = 2) +
  labs(title = "Procent przestępstw popełnianych w noc",
       x = "Procent przestępstw w nocy",
       y = "Rodzaj przestępstwa") +
  theme(plot.title = element_text(hjust = 0.5))

Dane mówią jasno - przestępcy nie są szczególnie aktywni nocą. W większości kategorii to w ciągu dnia popełnia się najwięcej przestępstw.

Czy istnieje zależność pomiędzy miejscem a rodzajem przestępstwa

W celu odpowiedzenia na pytanie z tytułu przeprowadzę test chi kwadrat.
Hipoteza główna: Zmienne są niezależne
Hipoteza alternatywna: Zmienne nie są niezależne

tabela_chi_kwadrat <- table(persons_crimes$offense_group, persons_crimes$location_category)
tabela_chi_kwadrat <- tabela_chi_kwadrat[rowSums(tabela_chi_kwadrat != 0) > 0, ] #usuwamy wiersze z samymi zerami

result_test_chi_kwadrat <- chisq.test(tabela_chi_kwadrat)
result_test_chi_kwadrat$p.value

## [1] 0

I w tym momencie możemy stwierdzić, że niezależnie od przyjętego poziomu istotności odrzucamy hipotezę główną. Zmienne nie są niezależne.

Spójrzmy jak bardzo zmienne są zależne za pomocą V-Cramera.

cramers_v <- sqrt(result_test_chi_kwadrat$statistic / sum(result_test_chi_kwadrat$observed) * (min(nrow(tabela_chi_kwadrat), ncol(tabela_chi_kwadrat)) - 1))
cramers_v

## X-squared 
## 0.2380794

Mówimy o średniej zależności, którą będziemy dokładniej oglądać za chwilę.

Aby lepiej poznać sytuację spoglądam jeszcze:

result_test_chi_kwadrat$statistic

## X-squared 
##  31098.32

result_test_chi_kwadrat$observed

##                       
##                        commercial education government healthcare  hotel
##   assault offenses          25596     24146       7348      14523  16048
##   homicide offenses            99        10          3         25     66
##   human trafficking            16         2          7         12    178
##   kidnapping/abduction        165       142         58         25    192
##   sex offenses               1270      2286        257       1594   2402
##                       
##                        leisure open space  other residence retail street
##   assault offenses       43028      67020 768325    685777  58360 325956
##   homicide offenses        103        812   7387      1862    217   3847
##   human trafficking          8         19    414       220     13    713
##   kidnapping/abduction      91        463   7367      4014    215   2133
##   sex offenses            1465       2512  24242     41123   1383   9431
##                       
##                        transportation vehicle
##   assault offenses              27169    7160
##   homicide offenses                27     359
##   human trafficking                 3       5
##   kidnapping/abduction             91      88
##   sex offenses                   3474    1223

result_test_chi_kwadrat$expected

##                       
##                         commercial   education  government  healthcare
##   assault offenses     25610.53508 25082.21048 7238.990484 15263.86381
##   homicide offenses      183.27909   179.49819   51.805072   109.23423
##   human trafficking       19.91492    19.50409    5.629086    11.86928
##   kidnapping/abduction   186.08697   182.24815   52.598738   110.90773
##   sex offenses          1146.18393  1122.53909  323.976620   683.12495
##                       
##                             hotel     leisure  open space       other
##   assault offenses     17817.7472 42166.90730 66819.85404 762046.9150
##   homicide offenses      127.5108   301.76302   478.18924   5453.5084
##   human trafficking       13.8552    32.78926    51.95955    592.5726
##   kidnapping/abduction   129.4643   306.38611   485.51521   5537.0574
##   sex offenses           797.4224  1887.15431  2990.48196  34104.9466
##                       
##                          residence      retail      street transportation
##   assault offenses     691535.3928 56783.57347 322730.8569    29023.88939
##   homicide offenses      4948.9001   406.36565   2309.5893      207.70640
##   human trafficking       537.7424    44.15527    250.9576       22.56916
##   kidnapping/abduction   5024.7184   412.59127   2344.9728      210.88852
##   sex offenses          30949.2462  2541.31432  14443.6234     1298.94653
##                       
##                            vehicle
##   assault offenses     8335.264033
##   homicide offenses      59.650438
##   human trafficking       6.481555
##   kidnapping/abduction   60.564297
##   sex offenses          373.039676

Widzimy, że istnieje zależność pomiędzy rodzajem popełnianego przestępstwa, a lokalizacją, spróbujmy znaleźć tę zależność, a posłuży mi do tego mapa ciepła.

Zależność pomiędzy miejscem a rodzajem przestępstwa

Dokonuję normalizacji danych, poprzez przekształcenie liczby przypadków przestępstw na proporcje względne, co umożliwia porównywanie wzorców zależności między zmiennymi kategorycznymi niezależnie od różnic w ogólnej liczbie przypadków, co ułatwia interpretację i porównanie zależności statystycznych.

row_normalized_table <- prop.table(tabela_chi_kwadrat, margin = 1) #normalizuję dane
  
pheatmap(
  row_normalized_table,
  color = colorRampPalette(c("white", "red"))(20),
  main = 'Typ przestępstwa a lokalizacja (znormalizowane)',
  fontsize = 10,
  border_color = 'black',
  cellwidth = 15,
  cellheight = 15
  )

Na podstawie wykresu mogę wysunąć wnioski:

• Przestępstwa seksualne mają wyższe prawdopodobieństwo wystąpienia w kategoriach “leisure” (rozrywka) i “residence” (miejsce zamieszkania).
• Przestępstwa związane z handlem ludźmi są bardziej prawdopodobne w miejscach oznaczonych jako “hotel” oraz “other” (inne).
• “Government” (instytucje rządowe) mają niskie ryzyko większości rodzajów przestępstw.
• Miejsca zamieszkania (“residence”) są bardziej narażone na różne rodzaje przestępstw, zwłaszcza przestępstwa typu “assault” (napad) i “sex offenses” (przestępstwa seksualne).
• “Street” (ulice) są bardziej narażone na “assault offenses” (napady) i “vehicle” (przestępstwa związane z pojazdami).
• “Homicide offenses” (przestępstwa zabójstwa) są stosunkowo niskie we wszystkich kategoriach miejscowych, z wyjątkiem “other” (inne).

Najpopularniejsze przestępstwo

Zastanówmy się teraz, która kategoria przestępstw jest najczęściej występującą. Spójrzmy na wykres:

crimes_type <- persons_crimes %>%
  group_by(offense_group) %>%
  summarise(number_of_crimes = n()/1000)
  
ggplot(crimes_type, aes(y = reorder(offense_group, number_of_crimes), x = number_of_crimes,
                        fill = "darkblue")) +
  geom_bar(stat = "identity") +
  labs(title = "Liczba przestępstw z poszególnych kategorii",
      x = "Liczba przestępstw w tysiącach",
      y = "Kategoria przestępstwa") +
  theme(plot.title = element_text(hjust = 0.5),
      legend.position = "none")+ 
  scale_fill_manual(values = c("darkblue" = "darkblue"))

Nie mamy żadnych wątpliwości - najczęściej obserwujemy napaście, później przestępstwa na tle seksualnym, a później - porwania. Najrzadziej zdarzają się podpalenia.

Spójrzmy teraz na to bardziej szczegółowo:

crimes_type <- persons_crimes %>%
  group_by(offense_type) %>%
  summarise(number_of_crimes = n()/1000)
  
ggplot(crimes_type, aes(y = reorder(offense_type, number_of_crimes), x = number_of_crimes,
                        fill = "darkblue")) +
  geom_bar(stat = "identity") +
  labs(title = "Liczba przestępstw z poszczególnych kategorii",
      x = "Liczba przestępstw w tysiącach",
      y = "Kategoria przestępstwa") +
  theme(plot.title = element_text(hjust = 0.5),
      legend.position = "none")+ 
  scale_fill_manual(values = c("darkblue" = "darkblue"))

Simple assault (atak prosty) jest najczęstszym rodzajem przestępstwa, z liczbą przypadków przekraczającą milion. Aggravated assault (zaostrzony) również występuje bardzo często, z ponad 587 000 przypadkami.

Sytuacja w Nowym Yorku

Nowy York kojarzy nam się jako miasto bardzo rozwinięte, Z dużą liczbą mieszkańców, kolorowymi reklamami i wysokimi budynkami. Dla wielu z nas odwiedzenie tego miasta jest marzeniem podróżniczym. Zauważyliśmy w poprzednich rozważaniach, że Nowy York jest miastem z największą liczbą przestępstw. Sprawdźmy, gdzie w Nowym Yorku jest najbezpieczniej.

persons_crimes_geo <- persons_crimes %>%
  filter(city_name == "New York") %>%
  select(uid, longitude, latitude)

leaflet(persons_crimes_geo) %>%
  addTiles() %>%
  addHeatmap(
    lat = ~latitude,
    lng = ~longitude,
    blur = 20,
    radius = 10
  )

Widzimy jasno - żadna część tego miasta nie jest bez skazy i tak naprawdę wszędzie trzeba uważać na siebie. Obszary o intensywniejszym kolorze na heatmapie wskazują na obszary o wyższym zagęszczeniu przestępczości.

Podsumowanie

Analiza ukazuje, że mimo rosnącej tendencji przestępczości w ostatnich latach, przestępstwa przeciwko ludziom stanowią mniejszość w porównaniu do przestępstw przeciwko własności. Nowy York wyróżnia się największą liczbą przestępstw, a Kansas City jest miastem z największą liczbą przestępstw w przeliczeniu na 1000 mieszkańców. Powinniśmy uważać na siebie o każdej porze doby, a lipiec okazał się miesiącem, gdzie liczba popełnianych przestępstw jest największa. Zależności między rodzajem przestępstwa a miejscem jego popełnienia są zauważalne, a analiza danych geograficznych dla Nowego Jorku ukazuje, że bezpieczne obszary są relatywnie rzadkie. Analiza wykazała, że atak prosty (simple assault) jest bezkonkurencyjnie najczęściej występującym rodzajem przestępstwa, przekraczającym liczbę miliona przypadków. Zrozumienie i skuteczne zarządzanie tymi zjawiskami może przyczynić się do poprawy ogólnego bezpieczeństwa społeczeństwa.